home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl5 / Debconf / DbDriver / Directory.pm < prev    next >
Encoding:
Perl POD Document  |  2009-03-24  |  3.5 KB  |  153 lines
  1. #!/usr/bin/perl -w
  2. # This file was preprocessed, do not edit!
  3.  
  4.  
  5. package Debconf::DbDriver::Directory;
  6. use strict;
  7. use Debconf::Log qw(:all);
  8. use IO::File;
  9. use POSIX;
  10. use Fcntl qw(:DEFAULT :flock);
  11. use Debconf::Iterator;
  12. use base 'Debconf::DbDriver::Cache';
  13.  
  14.  
  15. use fields qw(directory extension lock format);
  16.  
  17.  
  18. sub init {
  19.     my $this=shift;
  20.  
  21.     $this->{extension} = "" unless exists $this->{extension};
  22.     $this->{format} = "822" unless exists $this->{format};
  23.     $this->{backup} = 1 unless exists $this->{backup};
  24.     
  25.     $this->error("No format specified") unless $this->{format};
  26.     eval "use Debconf::Format::$this->{format}";
  27.     if ($@) {
  28.         $this->error("Error setting up format object $this->{format}: $@");
  29.     }
  30.     $this->{format}="Debconf::Format::$this->{format}"->new;
  31.     if (not ref $this->{format}) {
  32.         $this->error("Unable to make format object");
  33.     }
  34.  
  35.     $this->error("No directory specified") unless $this->{directory};
  36.     if (not -d $this->{directory} and not $this->{readonly}) {
  37.         mkdir $this->{directory} ||
  38.             $this->error("mkdir $this->{directory}:$!");
  39.     }
  40.     if (not -d $this->{directory}) {
  41.         $this->error($this->{directory}." does not exist");
  42.     }
  43.     debug "db $this->{name}" => "started; directory is $this->{directory}";
  44.     
  45.     if (! $this->{readonly}) {
  46.         open ($this->{lock}, ">".$this->{directory}."/.lock") or
  47.             $this->error("could not lock $this->{directory}: $!");
  48.         while (! flock($this->{lock}, LOCK_EX | LOCK_NB)) {
  49.             next if $! == &POSIX::EINTR;
  50.             $this->error("$this->{directory} is locked by another process: $!");
  51.             last;
  52.         }
  53.     }
  54. }
  55.  
  56.  
  57. sub load {
  58.     my $this=shift;
  59.     my $item=shift;
  60.  
  61.     debug "db $this->{name}" => "loading $item";
  62.     my $file=$this->{directory}.'/'.$this->filename($item);
  63.     return unless -e $file;
  64.  
  65.     my $fh=IO::File->new;
  66.     open($fh, $file) or $this->error("$file: $!");
  67.     $this->cacheadd($this->{format}->read($fh));
  68.     close $fh;
  69. }
  70.  
  71.  
  72. sub save {
  73.     my $this=shift;
  74.     my $item=shift;
  75.     my $data=shift;
  76.     
  77.     return unless $this->accept($item);
  78.     return if $this->{readonly};
  79.     debug "db $this->{name}" => "saving $item";
  80.     
  81.     my $file=$this->{directory}.'/'.$this->filename($item);
  82.  
  83.     my $fh=IO::File->new;
  84.     if ($this->ispassword($item)) {
  85.         sysopen($fh, $file."-new", O_WRONLY|O_TRUNC|O_CREAT, 0600)
  86.             or $this->error("$file-new: $!");
  87.     }
  88.     else {
  89.         open($fh, ">$file-new") or $this->error("$file-new: $!");
  90.     }
  91.     $this->{format}->beginfile;
  92.     $this->{format}->write($fh, $data, $item)
  93.         or $this->error("could not write $file-new: $!");
  94.     $this->{format}->endfile;
  95.     
  96.     $fh->flush or $this->error("could not flush $file-new: $!");
  97.     $fh->sync or $this->error("could not sync $file-new: $!");
  98.     close $fh or $this->error("could not close $file-new: $!");
  99.     
  100.     if (-e $file && $this->{backup}) {
  101.         rename($file, $file."-old") or
  102.             debug "db $this->{name}" => "rename failed: $!";
  103.     }
  104.     rename("$file-new", $file) or $this->error("rename failed: $!");
  105. }
  106.  
  107.  
  108. sub shutdown {
  109.     my $this=shift;
  110.     
  111.     $this->SUPER::shutdown(@_);
  112.     delete $this->{lock};
  113.     return 1;
  114. }
  115.  
  116.  
  117. sub exists {
  118.     my $this=shift;
  119.     my $name=shift;
  120.     
  121.     my $incache=$this->SUPER::exists($name);
  122.     return $incache if (!defined $incache or $incache);
  123.  
  124.     return -e $this->{directory}.'/'.$this->filename($name);
  125. }
  126.  
  127.  
  128. sub remove {
  129.     my $this=shift;
  130.     my $name=shift;
  131.  
  132.     return if $this->{readonly} or not $this->accept($name);
  133.     debug "db $this->{name}" => "removing $name";
  134.     my $file=$this->{directory}.'/'.$this->filename($name);
  135.     unlink $file or return undef;
  136.     if (-e $file."-old") {
  137.         unlink $file."-old" or return undef;
  138.     }
  139.     return 1;
  140. }
  141.  
  142.  
  143. sub accept {
  144.     my $this=shift;
  145.     my $name=shift;
  146.  
  147.     return if $name=~m#\.\./# or $name=~m#/\.\.#;
  148.     $this->SUPER::accept($name, @_);
  149. }
  150.  
  151.  
  152. 1
  153.